perm filename CLIP.F4[TMP,LCS] blob sn#469486 filedate 1979-08-22 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C THIS IS A SUBROUTINE TO XM3.FAI
C00018 ENDMK
CāŠ—;
C THIS IS A SUBROUTINE TO XM3.FAI
 	SUBROUTINE CLIP(J,K,L,IRT,LEFT,ITOP,IBOT)
	COMMON /CLIPXY/JJ,KK,JX,KX
C ZERO ABOVE IN FAIL PROG.
C ASSUMES N IS INITIALIZED =0
	IF(L.GT.0)GO TO 2
	IBOT=-K
	RETURN
2	JZ=J
	KZ=K
C SAVE THESE FOR LATER
	IF(L.NE.3)GO TO 1
	N=0
C DOESN'T WORK FOR JUMP OUT WITH INSVIS VECT.  MUST KNOW NEXT POINT
C TO SET PROPER ANGLE.
	IF(J.LT.LEFT)GO TO 40
	IF(J.GT.IRT)GO TO 41
44	IF(K.LT.IBOT)GO TO 42
	IF(K.GT.ITOP)GO TO 43
C NOW INBOUNDS
	GO TO 4
40	J=LEFT
	N=-1
	GO TO 44
41	J=IRT 
	N=-1
	GO TO 44
42	K=IBOT
	GO TO 45
43	K=ITOP
	GO TO 45

1	IF(N.EQ.0)GO TO 11
C JUMP IF LAST POINT WAS IN BOUNDS
	IF(JJ.LE.IRT.AND.JJ.GE.LEFT)GO TO 6
C NOW JJ IS OUT OF BOUNDS, CLIP IT
5	IF(IBOTH(J,JJ,LEFT,IRT).EQ.0)GO TO 4
C GO BACK IF ENTIRE SEGMENT IS OUT OF BOUNDS
 	CALL CLP(JJ,KK,J,K,JJ,KK,LEFT,IRT)
C CLIP FROM INVIS VECT WHICH IS OUT OF BOUNDS
	IF(KK.LE.ITOP.AND.KK.GE.IBOT)GO TO 10
C CLIP MORE IF OTHER POINT IS ALSO OUT.
6	IF(IBOTH(K,KK,IBOT,ITOP).EQ.0)GO TO 4
	CALL CLP(KK,JJ,K,J,KK,JJ,IBOT,ITOP)
CC10	CALL AIVECT(JJ,KK)
10	N=0
11	IF(J.GT.IRT.OR.J.LT.LEFT)GO TO 7
	IF(K.GT.ITOP.OR.K.LT.IBOT)GO TO 7
CC9	CALL AVECT(J,K)
4	JJ=JZ
	KK=KZ
C REMEMBER THE COORDS.
	RETURN
7 	CALL CLP(JX,KX,JJ,KK,J,K,LEFT,IRT)
	IF(KX.LE.ITOP.AND.KX.GE.IBOT)GO TO 12
	CALL CLP(KX,JX,KK,JJ,KX,JX,IBOT,ITOP)
12	J=JX
	K=KX
	JZ=J
	KZ=K
CC12	CALL AVECT(JX,KX)
45	N=-1
	GO TO 4
8 	CALL CLP(KX,JX,KK,JJ,K,J,IBOT,ITOP)
	GO TO 12
	END

	FUNCTION IBOTH(J,JJ,N1,N2)
	IBOTH=0 
	IF(JJ.GE.N2.AND.J.GT.N2)RETURN
	IF(JJ.LE.N1.AND.J.LT.N1)RETURN
	IBOTH=-1
	END

	SUBROUTINE CLP(JX,KX,JJ,KK,J,K,N1,N2)
C JJ,KK=OLD POINT    J,K=NEW POINT  JX,KX=CLIPPED
	JX=N2 
	IF(J.LT.N1)JX=N1
	IF(KK.NE.K)GO TO 1
	KX=KK
	RETURN
1	KX=KK+(K-KK)*(JX-JJ)/(J-JJ)
	END